Amiga Collections: Purity/Purity #23 (1994-02-10)(Diesel)(DE)[WB].zip/Purity #23 (1994-02-10)(Diesel)(DE)[WB].adf/Tools/ToolsUnit.p

Text File | 1994-01-20 | 5KB | 240 lines

UNIT Tools;

{ +--------------------------------------------------------------------+
  |                                Unit Tools                          |
  |                                                                    |
  |                               Version 1.30                         |
  |                                                                    |
  |              © Copyright 1993 by Björn Schotte (BOMBERSOFT)        |
  |                                                                    |
  |                           G  I  F  T  W  A  R  E                   |
  |                                                                    |
  |                                                                    |
  | Grüße und Dank gehen an:                                           |
  |                                                                    |
  | Diesel für die Purities und an Michael Klein für seine tollen      |
  | Prozeduren und für Røgerdat, Drucky, PPPClone, ...                 |
  +--------------------------------------------------------------------+ }


INTERFACE

  FROM MyTools USES ToolGad;
  FROM MyTools USES ToolTime;
  FROM MyTools USES ToolPAR;
  FROM MyTools USES ArpSupport;

  USES Graphics, Exec;

  {$incl "intuition/intuitionbase.h"}

  FUNCTION  FindWBScreen : p_Screen;
  FUNCTION  Exist(datei : String) : BOOLEAN;
  PROCEDURE Maus(MouseOnOff : BOOLEAN);
  PROCEDURE ToggleBool(VAR Boolsche : BOOLEAN);
  PROCEDURE Upper(VAR MakeUpper : STRING);
  FUNCTION  GetLongInt(gad:p_Gadget) : LONG;
  PROCEDURE SetLongInt(VAR gad:Gadget; Val:LONG);
  FUNCTION  GetString(gad:p_Gadget) : STRING;
  PROCEDURE SetString(VAR gad:Gadget; Stri:STRING);
  FUNCTION  MenuNum(code:LONGINT):CARDINAL;
  FUNCTION  ItemNum(code:LONGINT):CARDINAL;
  FUNCTION  SubNum(code:LONGINT):CARDINAL;
  FUNCTION  Zins(K,P:REAL; T:INTEGER):REAL;
  FUNCTION  Kapital(Z,P:REAL; T:INTEGER):REAL;
  FUNCTION  Zinssatz(Z,K:REAL; T:INTEGER):REAL;
  FUNCTION  Tage(Z,K,P:REAL):INTEGER;
  FUNCTION  ggT(a,b:LONG):LONG;
  FUNCTION  kgV(a,b:LONG):LONG;
  FUNCTION  Potenz(argument,hoch:REAL):REAL;

IMPLEMENTATION

  {$incl "libraries/dos.h","dos.lib"}

  VAR
    MausSave             : BYTE;

  FUNCTION FindWBScreen;
  VAR
    IBase : p_IntuitionBase;
    scr   : p_Screen;
    p     : LONG;
  BEGIN
    IBase := IntuitionBase;
    p := LockIBase(0);
    scr := IBase^.FirstScreen;
    While (scr^.Title <> "Workbench Screen") Do scr := scr^.NextScreen;
    UnLockIBase(p);
    FindWBScreen := scr;
  END;

  FUNCTION Exist;
  VAR
    ml : BPTR;
  BEGIN
    Exist := False;
    ml := Lock(datei,SHARED_LOCK);
    IF ml<>0 THEN
    BEGIN
      UnLock(ml);
      Exist := True;
    END;
  END;

  PROCEDURE Maus;
  BEGIN
    IF MouseOnOff=TRUE THEN
      MEM[$dff096] := MausSave
    ELSE
      MEM[$dff096] := 32;
  END;

  PROCEDURE ToggleBool;
  BEGIN
    IF Boolsche THEN
      Boolsche := FALSE
    ELSE
      Boolsche := TRUE;
  END;

  PROCEDURE Upper;
  VAR
    i : INTEGER;
  BEGIN
    FOR i := 1 TO Length(MakeUpper) DO
      MakeUpper[i] := UpCase(MakeUpper[i]);
  END;

  FUNCTION GetLongInt;
  VAR
    SpInf:p_StringInfo;
  BEGIN
    IF (gad^.GadgetType AND STRGADGET)<>0 THEN
    BEGIN
      SpInf:=gad^.SpecialInfo;
      GetLongInt:=SpInf^.LongInt;
    END ELSE GetLongInt:=0;
  END;

  PROCEDURE SetLongInt;
  VAR
    SpInf : p_StringInfo;
    x : STRING;
  BEGIN
    IF (gad.GadgetType AND STRGADGET)<>0 THEN
    BEGIN
      SpInf:=p_StringInfo(gad.SpecialInfo);
      x:=IntStr(Val);
      SpInf^.Buffer:=^x;
      SpInf^.LongInt:=Val;
    END;
  END;

  FUNCTION GetString;
  VAR
    SpInf : p_StringInfo;
    Stri  : STRING;
  BEGIN
    GetString := "";
    IF (gad^.SpecialInfo <> NIL) AND ((gad^.GadgetType AND STRGADGET)<>0) THEN
    BEGIN
      SpInf := p_StringInfo(gad^.SpecialInfo);
      Stri := SpInf^.Buffer;
      GetString := Stri;
    END;
  END;

  PROCEDURE SetString;
  VAR
    SpInf : p_StringInfo;
  BEGIN
    IF (gad.GadgetType AND STRGADGET)<>0 THEN
    BEGIN
      SpInf := p_StringInfo(gad.SpecialInfo);
      SpInf^.Buffer := ^Stri;
    END;
  END;

  FUNCTION MenuNum;
  BEGIN
    MenuNum := code AND %11111;
  END;

  FUNCTION ItemNum;
  VAR
    dummy : CARDINAL;
  BEGIN
    dummy := code AND %11111100000;
    ItemNum := dummy SHR 5;
  END;

  FUNCTION SubNum;
  VAR
    dummy : CARDINAL;
  BEGIN
    dummy := code AND %1111100000000000;
    SubNum := dummy SHR 11;
  END;

  FUNCTION Zins;
  BEGIN
    Zins := (k*p*t) / 36000;
  END;

  FUNCTION Kapital;
  BEGIN
    Kapital := (z*36000) / (t*p);
  END;

  FUNCTION Zinssatz;
  BEGIN
    Zinssatz := (z*36000) / (k*t);
  END;

  FUNCTION Tage;
  BEGIN
    Tage := Round((z*36000)/(k*p));
  END;

  FUNCTION ggT;
  VAR
    hilf : INTEGER;
  BEGIN
    WHILE a<>0 DO
    BEGIN
      hilf := ABS(a);
      a:=b MOD a;
      b:=hilf;
    END;
    ggT:=b;
  END;

  FUNCTION kgV;
  BEGIN
    kgV:=(a*b) DIV ggT(a,b);
  END;

  FUNCTION Potenz;
  BEGIN
    Potenz:=EXP(hoch*ln(Argument));
  END;

  BEGIN
    MausSave := MEM[$dff096];
  END.